home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / EdMenu.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  371 lines
  1. (*************************************************************************
  2.  
  3. :Program.       EdMenu.mod
  4. :Contents.      Menu-Handline for Amok-Editor
  5. :Author.        Hartmut Goebel
  6. :Copyright.     Copyright © 1987 by Matthew Dillon
  7. :Copyright.     Oberon implementation Copyright © 1991 by Hartmut Goebel
  8. :Language.      Oberon
  9. :Translator.    Amiga Oberon Compiler V2.00
  10. :History.       V1.0, 25 Feb 1991 Hartmut Goebel [hG]
  11. :History.       V1.1, 24 Apr 1991 [hG] +memoryFail; Code opitmiert
  12. :History.       V1.1b 24 May 1991 [hG] optimiert wg. Oberon V2.00
  13. :History.       V1.1c 15 Oct 1991 [hG] ^AddItem (+Dummy-Loop)
  14. :Date.          15 Oct 1991 14:41:20
  15.  
  16. *************************************************************************)
  17.  
  18. MODULE EdMenu;
  19.  
  20. IMPORT
  21.   e  : Exec,
  22.   edE: EdErrors,
  23.   edG: EdGlobalVars,
  24.   edL: EdLowLevel,
  25.   g  : Graphics,
  26.   I  : Intuition,
  27.   lst: EdLists,
  28.   ol : OberonLib,
  29.   str: Strings,
  30.   sys: SYSTEM;
  31.  
  32. TYPE
  33.   XItemPtr = POINTER TO XItem;
  34.   XItem = STRUCT  (item: I.MenuItem)
  35.     com: edG.StringPtr;
  36.   END;
  37.  
  38. VAR
  39.   Menu: I.MenuPtr;
  40.   MenuoffCnt: INTEGER;
  41.   DoMenuoffCnt: INTEGER;
  42.   doMenuDelReturn: BOOLEAN;
  43.  
  44. PROCEDURE MenuStrip*(win: I.WindowPtr);
  45. BEGIN
  46.   IF (MenuoffCnt=0) AND (Menu#NIL) AND I.SetMenuStrip(win,Menu^) THEN
  47.     e.Forbid();
  48.     EXCL(win.flags,I.rmbTrap);
  49.     e.Permit();
  50.   END;
  51. END MenuStrip;
  52.  
  53.  
  54. PROCEDURE Fixmenu;
  55. VAR
  56.   menu: I.MenuPtr;
  57.   item: I.MenuItemPtr;
  58.   it: I.IntuiTextPtr;
  59.   row,col,maxc,scr: INTEGER;
  60. BEGIN
  61.   col := 0;
  62.   menu := Menu;
  63.   WHILE menu#NIL DO
  64.     maxc := str.Length(menu.menuName^);
  65.     row := 0;
  66.     item := menu.firstItem;
  67.     WHILE item#NIL DO
  68.       it := item.itemFill;
  69.       item.topEdge := row;
  70.       scr := str.Length(it.iText^);
  71.       IF scr > maxc THEN maxc := scr END;
  72.       item.height := 10;
  73.       INC(row,item.height);
  74.       item := item.nextItem;
  75.     END;
  76.     maxc := (maxc * 8);
  77.     item := menu.firstItem;
  78.     WHILE item#NIL DO
  79.       item.width := maxc;
  80.       item := item.nextItem;
  81.     END;
  82.     menu.width := str.Length(menu.menuName^)*8+24;
  83.     menu.leftEdge := col;
  84.     menu.height := row;
  85.     INC(col,menu.width);
  86.     menu := menu.nextMenu;
  87.   END; (* WHILE menu#NIL *)
  88. END Fixmenu;
  89.  
  90.  
  91. PROCEDURE MenuOff;
  92. VAR
  93.   txt: edG.TextHeaderPtr;
  94. BEGIN
  95.   IF MenuoffCnt = 0 THEN
  96.     txt := edG.EditList.head(edG.TextHeader);
  97.     WHILE txt#NIL DO
  98.       I.ClearMenuStrip(txt.window);
  99.       e.Forbid();
  100.       INCL(txt.window.flags,I.rmbTrap);
  101.       e.Permit();
  102.       txt := txt.node.next(edG.TextHeader);
  103.     END;
  104.   END;
  105.   INC(MenuoffCnt);
  106. END MenuOff;
  107.  
  108.  
  109. PROCEDURE MenuOn;
  110. VAR
  111.   txt: edG.TextHeaderPtr;
  112. BEGIN
  113.   IF (Menu#NIL) AND (MenuoffCnt=1) THEN
  114.     Fixmenu;
  115.     txt := edG.EditList.head(edG.TextHeader);
  116.     WHILE txt#NIL DO
  117.       IF I.SetMenuStrip(txt.window,Menu^) THEN
  118.         e.Forbid();
  119.         EXCL(txt.window.flags,I.rmbTrap);
  120.         e.Permit();
  121.       END;
  122.       txt := txt.node.next(edG.TextHeader);
  123.     END;
  124.   END;
  125.   DEC(MenuoffCnt);
  126. END MenuOn;
  127.  
  128.  
  129. PROCEDURE MenuToMacro*(string: edG.StringPtr): edG.StringPtr;
  130. VAR
  131.   xitem: XItemPtr;
  132.   item: edG.StringPtr;
  133.   it: I.IntuiTextPtr;
  134.   menu: I.MenuPtr;
  135.   i: INTEGER;
  136. BEGIN
  137.   i := 0;
  138.   WHILE (string[i]#0X) AND (string[i]#"-") DO
  139.     INC(i); END;
  140.   IF string[i] = "-" THEN
  141.     string[i] := 0X;
  142.     item := sys.ADR(string[i+1]);
  143.     menu := Menu;
  144.     WHILE menu # NIL DO
  145.       IF string^ = menu.menuName^ THEN
  146.         xitem := menu.firstItem(XItemPtr);
  147.         WHILE xitem # NIL DO
  148.           it := xitem.item.itemFill;
  149.           IF item^ = it.iText^ THEN
  150.             string[i] := "-";
  151.             RETURN xitem.com; END;
  152.           xitem := xitem.item.nextItem;
  153.         END;
  154.       END;
  155.       menu := menu.nextMenu;
  156.     END;
  157.     string[i] := "-";
  158.   END;
  159.   RETURN NIL;
  160. END MenuToMacro;
  161.  
  162.  
  163. PROCEDURE GetMenuCmd*(im: I.IntuiMessagePtr): edG.StringPtr;
  164. VAR
  165.   item: XItemPtr;
  166. BEGIN
  167.   item := I.ItemAddress(Menu^,im.code);
  168.   IF item # NIL THEN RETURN item.com;
  169.                 ELSE RETURN NIL; END;
  170. END GetMenuCmd;
  171.  
  172.  
  173. (* gibt TRUE zurück, falls noch Items vorhanden sind *)
  174. PROCEDURE DelItem(menu: I.MenuPtr; item: XItemPtr): BOOLEAN;
  175. VAR
  176.   it: I.MenuItemPtr;
  177.   iptr: POINTER TO I.MenuItemPtr;
  178.   itxt: I.IntuiTextPtr;
  179. BEGIN
  180.   iptr := sys.ADR(menu.firstItem); (* dahin gehört der Nachfolger *)
  181.   it := menu.firstItem;
  182.   WHILE it # NIL DO
  183.     IF item = it THEN
  184.       iptr^ := it.nextItem;
  185.       itxt := it.itemFill;
  186.       DISPOSE(itxt.iText);
  187.       DISPOSE(item.com);
  188.       DISPOSE(item);  (* itxt hängt mit dran! SIZE(xitem)+SIZE(IntuitText) *)
  189.       IF menu.firstItem = NIL THEN RETURN FALSE;
  190.                               ELSE RETURN TRUE; END;
  191.     END;
  192.     iptr := sys.ADR(it.nextItem);
  193.     it := iptr^;
  194.   END;
  195.   RETURN FALSE;
  196. END DelItem;
  197.  
  198. (*-------------------------------------------------------------------------*)
  199.  
  200. (*
  201.  *  menuclear
  202.  *  menuadd     header  item    command
  203.  *  menudel     header  item
  204.  *  menudelhdr  header
  205.  *)
  206.  
  207. PROCEDURE doMenuOff*;
  208. BEGIN
  209.   MenuOff;
  210.   INC(DoMenuoffCnt);
  211. END doMenuOff;
  212.  
  213.  
  214. PROCEDURE doMenuOn*;
  215. BEGIN
  216.   IF DoMenuoffCnt#0 THEN
  217.     DEC(DoMenuoffCnt);
  218.     MenuOn;
  219.   END;
  220. END doMenuOn;
  221.  
  222.  
  223. PROCEDURE doMenuAdd*;
  224. VAR
  225.   it: I.IntuiTextPtr;
  226.   menu: I.MenuPtr;
  227.   mpr: POINTER TO I.MenuPtr;
  228.   item: I.MenuItemPtr;
  229.   ipr: POINTER TO I.MenuItemPtr;
  230.  
  231.   PROCEDURE NewName(xitem: XItemPtr);    (*  create new name *)
  232.   BEGIN
  233.     (*IF xitem.com # NIL THEN*) DISPOSE(xitem.com);(* END;*)
  234.     xitem.com := edL.CopyString(edG.Arg[2]);
  235.     MenuOn;
  236.   END NewName;
  237.  
  238. BEGIN
  239.   MenuOff;
  240.   LOOP (* Dummy *)
  241.     mpr := sys.ADR(Menu);
  242.     menu := Menu;
  243.     WHILE menu # NIL DO
  244.       IF edG.Arg[0]^ = menu.menuName^ THEN
  245.         ipr := sys.ADR(menu.firstItem);
  246.         item := ipr^;
  247.         WHILE item # NIL DO
  248.           it := item.itemFill;
  249.           IF edG.Arg[1]^ = it.iText^ THEN
  250.              NewName(item(XItem));
  251.              RETURN;
  252.           END;
  253.           ipr := sys.ADR(item.nextItem);
  254.           item := ipr^;
  255.         END;
  256.         EXIT;
  257.       END;
  258.       mpr := sys.ADR(menu.nextMenu);
  259.       menu := mpr^;
  260.     END;
  261.     (*
  262.      * Create new Menu
  263.      *)
  264.     ol.New(menu,sys.SIZE(I.Menu));
  265.     IF menu = NIL THEN
  266.       INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
  267.       RETURN;
  268.     END;
  269.     menu.nextMenu := mpr^;
  270.     mpr^ := menu;
  271.     menu.flags := {I.menuEnabled};
  272.     menu.menuName := sys.VAL(e.STRPTR,edL.CopyString(edG.Arg[0]));
  273.     ipr := sys.ADR(menu.firstItem);
  274.     ipr^ := NIL;
  275.     EXIT;
  276.   END; (* Dummy-Loop *)
  277.   (*
  278.    * Create New Item
  279.    *)
  280.   ol.New(item,sys.SIZE(XItem)+sys.SIZE(I.IntuiText));
  281.   IF item = NIL THEN
  282.     INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
  283.     RETURN;
  284.   END;
  285.   it := sys.VAL(e.ADDRESS,item)+sys.SIZE(XItem);
  286.   it.iText := edL.CopyString(edG.Arg[1]);
  287.   it.backPen := 1;
  288.   it.drawMode := g.jam2;
  289.   item.nextItem := ipr^; ipr^ := item; (* verketten *)
  290.   item.itemFill := it;
  291.   item.flags := {I.itemText,I.itemEnabled,I.highComp};
  292.   NewName(item(XItem));
  293. END doMenuAdd;
  294.  
  295.  
  296. PROCEDURE doMenuDelHdr*;
  297. VAR
  298.   menu: I.MenuPtr;
  299.   mpr: POINTER TO I.MenuPtr;
  300. BEGIN
  301.   MenuOff;
  302.   mpr := sys.ADR(Menu);
  303.   menu := mpr^;
  304.   WHILE menu # NIL DO
  305.     IF edG.Arg[0]^ = menu.menuName^ THEN
  306.       WHILE (menu.firstItem # NIL)
  307.       AND DelItem(menu,menu.firstItem(XItem)) DO
  308.       END;
  309.       mpr^ := menu.nextMenu;
  310.       DISPOSE(menu.menuName);
  311.       DISPOSE(menu);
  312.       MenuOn;
  313.       RETURN;
  314.     END; (* IF edG.Arg[0]^ = menu.menuName^ *)
  315.     mpr := sys.ADR(menu.nextMenu);
  316.     menu := mpr^;
  317.   END;
  318.   MenuOn;
  319. END doMenuDelHdr;
  320.  
  321.  
  322. PROCEDURE doMenuDel*;
  323. VAR
  324.   menu: I.MenuPtr;
  325.   item: I.MenuItemPtr;
  326.   ipr: POINTER TO I.MenuItemPtr;
  327.   it: I.IntuiTextPtr;
  328.   xitem: XItemPtr;
  329. BEGIN
  330.   MenuOff;
  331.   menu := Menu;
  332.   WHILE menu# NIL DO
  333.     IF edG.Arg[0]^ = menu.menuName^ THEN
  334.       ipr := sys.ADR(menu.firstItem); (* dahin gehört der Nachfolger *)
  335.       item := ipr^;
  336.       WHILE item # NIL DO
  337.         it := item.itemFill;
  338.         IF edG.Arg[1]^ = it.iText^ THEN
  339.           IF NOT DelItem(menu,item(XItem)) THEN
  340.             doMenuDelHdr; END;
  341.           MenuOn;
  342.           RETURN;
  343.         END;
  344.         ipr := sys.ADR(item.nextItem);
  345.         item := ipr^;
  346.       END;
  347.     END;
  348.     menu := menu.nextMenu;
  349.   END;
  350.   MenuOn;
  351. END doMenuDel;
  352.  
  353.  
  354. PROCEDURE doMenuClear*;
  355. BEGIN
  356.   MenuOff;
  357.   WHILE Menu # NIL DO
  358.     edG.Arg[0] := sys.VAL(e.ADDRESS,Menu.menuName);
  359.     doMenuDelHdr;
  360.   END;
  361.   MenuOn;
  362. END doMenuClear;
  363.  
  364. BEGIN
  365.   Menu := NIL; MenuoffCnt := 0; DoMenuoffCnt := 0;
  366. CLOSE
  367. (*  MenuOff;
  368.   doMenuClear; *)
  369. END EdMenu.
  370.  
  371.